perm filename SC4.F4[M11,LCS] blob
sn#439869 filedate 1979-05-08 generic text, type T, neo UTF8
SUBROUTINE OUTINF
COMMON /TYP/JOUT,LN,KTYPE
COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
1 Y,Z,FNAME,MZ /D/TF,AMPFAC,OMIT,DURX,IXIN
DATA SCOR/'SCOR'/,BLA/' '/
WRITE(JTYPE,117)
READ(JTYPE,116)AMPFAC,TF,OMIT,DURX
IF(TF.EQ.0)TF=1.
IF(AMPFAC.EQ.0)AMPFAC=1.
IF(DURX.EQ.0)DURX=19999.
115 FORMAT(9I)
116 FORMAT(4F)
112 FORMAT(A4)
118 FORMAT(' TO DSK=1 TTY=2 BOTH=0 LPT=4 '$)
117 FORMAT(' TYPE AMPFAC, TEMPFAC, OMIT, DUR, OR <CR> '$)
113 FORMAT(' OUTPUT NAME? (<CR>="SCOR") '$)
WRITE(JTYPE,118)
READ(JTYPE,115)MX,IXIN,INONLY
C MX=WHERE TO SEND OUTPUT, IXIN=RAN NUM, INONLY=INST NUM. TO RUN SINGLE INST.
JOUT=5
C 5=OUTPUT TO TTY
IF(MX.EQ.4)JOUT=3
C MX=4=DIRECT TO LPT
C MX=10,11,ETC.,22,ETC. SUPPRESSES INPUT LISTING. (33=0)
KTYPE=0
IF(MX.LT.10)GO TO 1
KTYPE=-1
C =-1= DON'T TYPE OUT INPUT FILE.
MX=MX/11
1 IF(INONLY.EQ.0)INONLY=-1
MZ=0
GO TO(110,210,310,210,510,610)MX
C 0=DSK,TTY 1=DSK 2=TTY 3=0 4=LPT 5=TTY 6=TTY
310 MZ=-1
110 WRITE(JTYPE,113)
READ(JTYPE,112)FNAME
IF(FNAME.EQ.BLA)FNAME=SCOR
MX=-1
CALL DISKO(ID20,FNAME,4)
RETURN
210 MZ=-1
510 RETURN
610 MZ=-6
RETURN
C1114 FORMAT(' FOR THE ABOVE YOU MAY TYPE UP TO 3 NUMBERS: N1 N2 N3'//
C 1' N1 = 1 WRITES DATA ON DSK, =2 WRITES ONLY ON SCREEN,'/
C 1' = 0 WRITES ON DSK AND SCREEN.'/
C 1' = 11,22,33 ARE THE SAME AS 1,2,0 BUT INPUT LIST IS NOT
C 1 WRITTEN ON SCREEN.'/
C 1/' N2 = RAN NUM INITIALIZATION. N3 = DO ONLY INST. #N'/
C 1/' ALSO FOR N1: N1=5(OR 55)=DURS ONLY (FOR PROOFING)
C 1, =6(OR 66)=DEBUG V ARRAY'//
C 1 3X' UP TO 30 PARAMETERS AND 27 INSTRUMENTS ARE AVAILABLE'/)
END
C ***** SUBROUTINES TO GO WITH S3X.F4 (RUNIT) *******
C* MICRO, RMOVX, ALL, POINTR, RAND,PARAM 7/78
FUNCTION RMOVX(W,Y,Z)
IF(W.EQ.0)W=.01
IF(Y.EQ.0)Y=.01
RMOVX=Y*((W/Y)**Z)
END
FUNCTION ALL(JPT,IPTX)
COMMON /VV/LIMIT,V(1)
DIMENSION JPT(1)
K=IPTX-1
IF(K.GT.0)GO TO 2
1 K=JPT(-K)
IF(K.LT.0)GO TO 1
C FOR 'ALL' WITH RR,RD,DF. FOLLOWS UP ON POINTERS TO POINTERS!
K=K-1
2 ALL=PARAM(V(K+3),K)
END
C***** THIS IS NOW A 'FAIL' ROUTINE IN SPRINT.FAI
FUNCTION PARAM(X,K)
COMMON J,L /P/P(1) /PL/IPL(1) /C/T,NWZZ,IT3,T6,NW,TDUR,A,
1 T2,T4,BY,KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,IPM,NM,PAR,PX2
K=0
C IF K IS NOT ZERO UPON RETURN, THEN WE'VE FOUND INFO IN OTHER PARAM.
PARAM=X
IF(X.GT.-9999.0)RETURN
IF(X.EQ.-10000.0)RETURN
K=-(X+9999.0)*100.+.1
PARAM=P(K)
C GET DATA FROM PARAM K
IPM=IPL(K)
IF(L.NE.2)RETURN
C L=CALLING PARAM NUM., K=PARAM REFERRED TO.
IF(K.EQ.2)PARAM=PX2
C MUST USE 'UNPROCESSED' FORM OF P2 (I.E. NO 'TEMPO' CHANGES)
END
C***** MICROTONES ********
SUBROUTINE MICRO
COMMON INUM,IPAR /P/P(1) /PL/IPL(2),IPL3
C CALL SUBROUTINE FROM ANY PARAMETER WHERE THE CALLING PARAMETER
C AND THE IMMEDITELY PRECEDING PARAMETER ARE UNUSED BY YOUR INSTR.
C P3 CAN BE NOTES OR NUMBS.
X=P(3)
IF(IPL3.EQ.1)GO TO 1
CC X=IFIX(X)
C FOR RAND NOTES TO LOCK ON NOTE NUMBERS.
CC X=30.8677*2**(X/12)
X=15.43385*2**(X/12)
C X=FREQ. IN HZ. BASED ON NT # IN P3. NUM. ABOVE IS B, IE. LOWEST B -1 OCT.
IPL3=1
C THIS CAUSES FREQ. NUM TO PRINT INSTEAD OF LITERAL CHARACTERS.
1 Y=IFIX(P(IPAR-1))
Z=IFIX(P(IPAR))
C FIX NEEDED BECAUSE OF POSSIBLE NON-INTEGERS HERE.
P(3)=X*2**(Y/Z)
C IPAR (Z) IS THE CALLING PARAMETER. IPAR-1 (Y) THE PREVIOUS PARAM.
C X HAS BASE FREQ.
C THE NUMBER IN P(IPAR)=# OF DIVISIONS OF THE OCTAVE.
C THE NUMBER IN P(IPAR-1)=CHROMATIC STEP IN THAT DIV.
END
FUNCTION RAND(A,B)
COMMON /IRX/IR1,IR2
RAND=A+(B-A)*RAN(IR1,IR2)
C RAN IS IN FORTRAN LIB.
END